home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / config_data < prev    next >
Encoding:
Text File  |  2009-10-01  |  7.1 KB  |  253 lines
  1. #!/usr/bin/perl
  2.     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  3.     if $running_under_some_shell;
  4. #!/usr/bin/perl
  5.  
  6. use strict;
  7. use Module::Build 0.25;
  8. use Getopt::Long;
  9.  
  10. my %opt_defs = (
  11.         module      => {type => '=s',
  12.                 desc => 'The name of the module to configure (required)'},
  13.         feature     => {type => ':s',
  14.                 desc => 'Print the value of a feature or all features'},
  15.         config      => {type => ':s',
  16.                 desc => 'Print the value of a config option'},
  17.         set_feature => {type => '=s%',
  18.                 desc => "Set a feature to 'true' or 'false'"},
  19.         set_config  => {type => '=s%',
  20.                 desc => 'Set a config option to the given value'},
  21.         eval        => {type => '',
  22.                 desc => 'eval() config values before setting'},
  23.         help        => {type => '',
  24.                 desc => 'Print a help message and exit'},
  25.            );
  26.  
  27. my %opts;
  28. GetOptions( \%opts, map "$_$opt_defs{$_}{type}", keys %opt_defs ) or die usage(%opt_defs);
  29. print usage(%opt_defs) and exit(0)
  30.   if $opts{help};
  31.  
  32. my @exclusive = qw(feature config set_feature set_config);
  33. die "Exactly one of the options '" . join("', '", @exclusive) . "' must be specified\n" . usage(%opt_defs)
  34.   unless grep(exists $opts{$_}, @exclusive) == 1;
  35.  
  36. die "Option --module is required\n" . usage(%opt_defs)
  37.   unless $opts{module};
  38.  
  39. my $cf = load_config($opts{module});
  40.  
  41. if (exists $opts{feature}) {
  42.  
  43.   if (length $opts{feature}) {
  44.     print $cf->feature($opts{feature});
  45.   } else {
  46.     my %auto;
  47.     # note: need to support older ConfigData.pm's
  48.     @auto{$cf->auto_feature_names} = () if $cf->can("auto_feature_names");
  49.  
  50.     print " Features defined in $cf:\n";
  51.     foreach my $name (sort $cf->feature_names) {
  52.       print "  $name => ", $cf->feature($name), (exists $auto{$name} ? " (dynamic)" : ""), "\n";
  53.     }
  54.   }
  55.  
  56. } elsif (exists $opts{config}) {
  57.  
  58.   require Data::Dumper;
  59.   local $Data::Dumper::Terse = 1;
  60.  
  61.   if (length $opts{config}) {
  62.     print Data::Dumper::Dumper($cf->config($opts{config})), "\n";
  63.   } else {
  64.     print " Configuration defined in $cf:\n";
  65.     foreach my $name (sort $cf->config_names) {
  66.       print "  $name => ", Data::Dumper::Dumper($cf->config($name)), "\n";
  67.     }
  68.   }
  69.  
  70. } elsif (exists $opts{set_feature}) {
  71.   my %to_set = %{$opts{set_feature}};
  72.   while (my ($k, $v) = each %to_set) {
  73.     die "Feature value must be 0 or 1\n" unless $v =~ /^[01]$/;
  74.     $cf->set_feature($k, 0+$v); # Cast to a number, not a string
  75.   }
  76.   $cf->write;
  77.   print "Feature" . 's'x(keys(%to_set)>1) . " saved\n";
  78.  
  79. } elsif (exists $opts{set_config}) {
  80.  
  81.   my %to_set = %{$opts{set_config}};
  82.   while (my ($k, $v) = each %to_set) {
  83.     if ($opts{eval}) {
  84.       $v = eval($v);
  85.       die $@ if $@;
  86.     }
  87.     $cf->set_config($k, $v);
  88.   }
  89.   $cf->write;
  90.   print "Config value" . 's'x(keys(%to_set)>1) . " saved\n";
  91. }
  92.  
  93. sub load_config {
  94.   my $mod = shift;
  95.  
  96.   $mod =~ /^([\w:]+)$/
  97.     or die "Invalid module name '$mod'";
  98.   
  99.   my $cf = $mod . "::ConfigData";
  100.   eval "require $cf";
  101.   die $@ if $@;
  102.  
  103.   return $cf;
  104. }
  105.  
  106. sub usage {
  107.   my %defs = @_;
  108.  
  109.   my $out = "\nUsage: $0 [options]\n\n  Options include:\n";
  110.   
  111.   foreach my $name (sort keys %defs) {
  112.     $out .= "  --$name";
  113.     
  114.     for ($defs{$name}{type}) {
  115.       /^=s$/  and      $out .= " <string>";
  116.       /^=s%$/ and      $out .= " <string>=<value>";
  117.     }
  118.  
  119.     pad_line($out, 35);
  120.     $out .= "$defs{$name}{desc}\n";
  121.   }
  122.  
  123.   $out .= <<EOF;
  124.  
  125.   Examples:
  126.    $0 --module Foo::Bar --feature bazzable
  127.    $0 --module Foo::Bar --config magic_number
  128.    $0 --module Foo::Bar --set_feature bazzable=1
  129.    $0 --module Foo::Bar --set_config magic_number=42
  130.  
  131. EOF
  132.  
  133.   return $out;
  134. }
  135.  
  136. sub pad_line {  $_[0] .= ' ' x ($_[1] - length($_[0]) + rindex($_[0], "\n")) }
  137.  
  138.  
  139. __END__
  140.  
  141. =head1 NAME
  142.  
  143. config_data - Query or change configuration of Perl modules
  144.  
  145. =head1 SYNOPSIS
  146.  
  147.   # Get config/feature values
  148.   config_data --module Foo::Bar --feature bazzable
  149.   config_data --module Foo::Bar --config magic_number
  150.   
  151.   # Set config/feature values
  152.   config_data --module Foo::Bar --set_feature bazzable=1
  153.   config_data --module Foo::Bar --set_config magic_number=42
  154.   
  155.   # Print a usage message
  156.   config_data --help
  157.  
  158. =head1 DESCRIPTION
  159.  
  160. The C<config_data> tool provides a command-line interface to the
  161. configuration of Perl modules.  By "configuration", we mean something
  162. akin to "user preferences" or "local settings".  This is a
  163. formalization and abstraction of the systems that people like Andreas
  164. Koenig (C<CPAN::Config>), Jon Swartz (C<HTML::Mason::Config>), Andy
  165. Wardley (C<Template::Config>), and Larry Wall (perl's own Config.pm)
  166. have developed independently.
  167.  
  168. The configuration system emplyed here was developed in the context of
  169. C<Module::Build>.  Under this system, configuration information for a
  170. module C<Foo>, for example, is stored in a module called
  171. C<Foo::ConfigData>) (I would have called it C<Foo::Config>, but that
  172. was taken by all those other systems mentioned in the previous
  173. paragraph...).  These C<...::ConfigData> modules contain the
  174. configuration data, as well as publically accessible methods for
  175. querying and setting (yes, actually re-writing) the configuration
  176. data.  The C<config_data> script (whose docs you are currently
  177. reading) is merely a front-end for those methods.  If you wish, you
  178. may create alternate front-ends.
  179.  
  180. The two types of data that may be stored are called C<config> values
  181. and C<feature> values.  A C<config> value may be any perl scalar,
  182. including references to complex data structures.  It must, however, be
  183. serializable using C<Data::Dumper>.  A C<feature> is a boolean (1 or
  184. 0) value.
  185.  
  186. =head1 USAGE
  187.  
  188. This script functions as a basic getter/setter wrapper around the
  189. configuration of a single module.  On the command line, specify which
  190. module's configuration you're interested in, and pass options to get
  191. or set C<config> or C<feature> values.  The following options are
  192. supported:
  193.  
  194. =over 4
  195.  
  196. =item module
  197.  
  198. Specifies the name of the module to configure (required).
  199.  
  200. =item feature
  201.  
  202. When passed the name of a C<feature>, shows its value.  The value will
  203. be 1 if the feature is enabled, 0 if the feature is not enabled, or
  204. empty if the feature is unknown.  When no feature name is supplied,
  205. the names and values of all known features will be shown.
  206.  
  207. =item config
  208.  
  209. When passed the name of a C<config> entry, shows its value.  The value
  210. will be displayed using C<Data::Dumper> (or similar) as perl code.
  211. When no config name is supplied, the names and values of all known
  212. config entries will be shown.
  213.  
  214. =item set_feature
  215.  
  216. Sets the given C<feature> to the given boolean value.  Specify the value
  217. as either 1 or 0.
  218.  
  219. =item set_config
  220.  
  221. Sets the given C<config> entry to the given value.
  222.  
  223. =item eval
  224.  
  225. If the C<--eval> option is used, the values in C<set_config> will be
  226. evaluated as perl code before being stored.  This allows moderately
  227. complicated data structures to be stored.  For really complicated
  228. structures, you probably shouldn't use this command-line interface,
  229. just use the Perl API instead.
  230.  
  231. =item help
  232.  
  233. Prints a help message, including a few examples, and exits.
  234.  
  235. =back
  236.  
  237. =head1 AUTHOR
  238.  
  239. Ken Williams, kwilliams@cpan.org
  240.  
  241. =head1 COPYRIGHT
  242.  
  243. Copyright (c) 1999, Ken Williams.  All rights reserved.
  244.  
  245. This library is free software; you can redistribute it and/or modify
  246. it under the same terms as Perl itself.
  247.  
  248. =head1 SEE ALSO
  249.  
  250. Module::Build(3), perl(1).
  251.  
  252. =cut
  253.